home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
rga
/
rga1.frm
< prev
next >
Wrap
Text File
|
1995-12-05
|
4KB
|
196 lines
VERSION 2.00
Begin Form Form1
Caption = "I Love WinApps!"
ClientHeight = 3960
ClientLeft = 990
ClientTop = 1950
ClientWidth = 6525
Height = 4650
Icon = RGA1.FRX:0000
Left = 930
LinkMode = 1 'Source
LinkTopic = "Form1"
ScaleHeight = 3960
ScaleWidth = 6525
Top = 1320
Width = 6645
Begin Menu FileMenuNull
Caption = "&File"
Begin Menu FileMenuAbout
Caption = "&About"
Shortcut = {F1}
End
Begin Menu FileMenuFiller1
Caption = "-"
End
Begin Menu FileMenuExit
Caption = "E&xit"
End
End
End
'
' This has variables germane to multiple procedures in the
' form. Otherwise, Visual Basic would have each form having
' its own variables.
'
Dim FirstTimeThrough As Integer
Dim ResizeOnly As Integer
Sub FileMenuAbout_Click ()
'
' This runs when the user requests "File, About":
'
' Build a message.
'
A$ = "The " + Chr$(34) + ILWA$ + Chr$(34) + " Program" + Chr$(13) + Chr$(10) + "by Charles L. Perrin"
'
' Display the message.
'
MsgBox A$, 64, ILWA$
'
End Sub
Sub FileMenuExit_Click ()
'
' This executes when the user does the Exit request:
'
End
'
' and that's all, folks!
'
End Sub
Sub Form_Click ()
'
' This is invoked every time a mouse click is in the window.
'
Dim FontMax, FontNo, THW, THH As Integer
'
' Clear the screen.
'
Cls
'
' Don't switch fonts if we're only redrawing.
'
If Not (ResizeOnly) Then
'
' Is not the first time through?
'
If Not (FirstTimeThrough) Then
'
' Get number of fonts currently defined for the screen.
' (The number of screen fonts can change on the fly!)
'
FontMax = Screen.FontCount
'
' This begins a loop that obtains candidate fonts, and
' throws out the ones that aren't text!
'
Do
'
' Come up with a random font number.
'
FontNo = Int(FontMax * Rnd(1))
'
' Get the font name.
'
ProposedFontName$ = Screen.Fonts(FontNo)
'
' Convert the font name to upper case for matching ease.
'
ProposedFontUC$ = UCase$(ProposedFontName$)
'
' I'm not going to let this loop exit on three cases:
' DINGBAT fonts, SYMBOL fonts, or the DIGITAL (Clock) font.
'
Loop Until ((InStr(ProposedFontUC$, "DINGBAT") = 0) And (InStr(ProposedFontUC$, "SYMBOL") = 0) And (ProposedFontUC$ <> "DIGITAL"))
'
' Set the font name to the proposed font name.
'
FontName = ProposedFontName$
'
' Or, is this the first time through?
'
Else
'
' First time through - use the first font (SYSTEM, usually).
'
FontName = Screen.Fonts(0)
'
End If
'
End If
'
' Set the font size to 12 points.
'
FontSize = 12
'
' Determine half the text width.
'
THW = TextWidth(ILWA$) / 2
'
' Determine half the text height.
'
THH = TextHeight(ILWA$) / 2
'
' Set the X, Y screen position to center the text.
'
CurrentX = ScaleWidth / 2 - THW
CurrentY = ScaleHeight / 2 - THH
'
' Print the text "I Love WinApps!"
'
Print ILWA$
'
' Indicate that the resize is finished.
'
ResizeOnly = False
'
' Indicate that this isn't the first time through.
'
FirstTimeThrough = False
'
End Sub
Sub Form_Load ()
'
' This gets executed when the module loads:
'
' Seed the random number generator.
'
Randomize
'
' Indicate that the form is to automatically redraw.
'
AutoRedraw = True
'
' Indicate that this is the first time through.
'
FirstTimeThrough = True
'
' Simulate the initial click to bring up the text.
'
Form_Click
'
End Sub
Sub Form_Resize ()
'
' This gets entered if the user's been playing with that
' big fat border and resizing this puppy!
'
' Clear the screen.
'
Cls
'
' Indicate that only a resize operation is to take place.
'
ResizeOnly = True
'
' Simulate a form click and let that finish the job!
'
Form_Click
'
End Sub